home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 098 / eds.arc / EDSARRAY.LSP < prev    next >
Encoding:
Text File  |  1980-01-01  |  2.0 KB  |  67 lines
  1. ;This funcion sets up and array of Integers, Reals or
  2. ;Letters.  The array direction may be positive or neg-
  3. ;ative and the value step can be any increment.
  4. ;
  5. ;Function name "EDSARRAY.LSP" - Execution command "AR"
  6. ;
  7. ;Written by Christopher Conrad and Steve Brown
  8. ;
  9. ;
  10. ;
  11. (defun c:ar ()
  12.   (setq flet "a")
  13.   (setq charval 65)
  14.   (setq pnt (getpoint "Origin of array : "))
  15.   (setq ynum (getint "Number of rows : "))
  16.   (setq xnum (getint "Number of columns : "))
  17.   (setq dy (getreal "Distance between rows (real number) : "))
  18.   (setq dx (getreal "Distance between columns (real number) : "))
  19.   (setq just (getstring "Justification : "))
  20.   (setq tsiz (getstring "Text size : "))
  21.   (setq rot (getstring "Rotation : "))
  22.   (setq txtype (getstring "Real, Integer, or Letters (R,I,or L) :
  23.   "))
  24.   (if (= txtype "L")
  25.       (setq flet (getstring "First letter : "))
  26.       (if (= txtype "I")
  27.           (progn (setq fnum (getint "First integer : "))
  28.                  (setq incr (getint "Increment : ")))
  29.               (progn (setq fnum (getreal "First real : "))
  30.                      (setq incr (getreal "Increment : "))
  31.                      (setq sigdig (getint "Number of significant digits :
  32.           ")))
  33.        )
  34.   )
  35. ;
  36.   (setq txtval 0)
  37.   (setq fcv (ascii flet))
  38.   (setq ycount 0) (setq xcount 0)
  39.   (while (< ycount ynum)
  40.       (while (< xcount xnum)
  41.           (setq xpnt (+ (car pnt) (* DX xcount)))
  42.           (setq ypnt (+ (cadr pnt) (* DY ycount)))
  43.           (setq txloc (list xpnt ypnt))
  44.  
  45. ;determine text
  46.   (if (= txtype "L")
  47.       (progn (setq tx (+ fcv txtval))
  48.              (setq text (chr tx)))
  49.       (if (= txtype "I")
  50.              (setq text (+ fnum (* incr txtval)))
  51.              (progn (setq tx (* incr txtval))
  52.                     (setq tx (+ fnum tx))
  53.                     (setq text (rtos tx 2 sigdig)))
  54.  
  55.  
  56.       )
  57.   )
  58.       (command "text" just txloc tsiz rot text)
  59.       (setq txtval (1+ txtval))
  60.       (setq xcount (1+ xcount))
  61.       )
  62.       (setq xcount 0)
  63.   (setq ycount (1+ ycount))
  64.   )
  65. )
  66.  
  67.